;<FOONEX>PISRV.MAC;124 18-Mar-81 20:44:38, Edit by MMCM
; SUMEX ERJMP/ERCAL CHANGES
;DSK:<FOONEX>PISRV.MAC;120 19-Sep-80 14:22:30, Edit by DANG
; Added versatec device VTC
;<134-TENEX>PISRV.MAC;119    19-Jun-80 12:48:44    EDIT BY LYNCH
;CHANGED ENTRY VECTOR LOCATION FROM 100 TO 140 TO MAKE LINK HAPPY.
;DSK:<134-TENEX>PISRV.MAC;116 18-May-80 21:47:20, Edit by PETERS
; Added junk to support macros in TOPS20 flavored modules
;<134-TENEX>PISRV.MAC;115    27-Jan-80 18:10:23    EDIT BY PETERS
; Fix KAFLG to KAFLG!F3FLG
;<134-TENEX>PISRV.MAC;114    17-Nov-79 23:55:13    EDIT BY PETERS
;Made memory parity errors always bughlt
;<134-TENEX>PISRV.MAC;113    28-Sep-79 11:42:20    EDIT BY LYNCH
; ADDED START AS EQUIVALENT ADDRESS TO SYSGO1 FOR SANITY
;<134-TENEX>PISRV.MAC;112    29-Aug-78 21:25:13    EDIT BY PETERS
;<134-TENEX>PISRV.MAC;111     6-Jul-78 17:20:52    EDIT BY PETERS
;<134-TENEX>PISRV.MAC;110    16-May-78 17:02:24    EDIT BY PETERS
;<134-TENEX>PISRV.MAC;109    13-DEC-77 16:10:08    EDIT BY PETERS
;<135-TENEX>PISRV.MAC;108    21-NOV-75 13:34:27    EDIT BY ROSENBERG
; MODIFY MEM PAR ERR CODE TO SCAN MORE THAN 256K OF MEMORY
; AUGMENT THE ADDRESS BREAK LOGIC AND ADD MORE COMMENTS TO IT
;<134-TENEX>PISRV.MAC;98    14-MAY-75 21:11:37    EDIT BY SYSTEM
; ADD DISPATCH FOR TELENET INTERFACE ON CHANNEL 5
;<133-TENEX>PISRV.MAC;97    25-SEP-74 12:54:23    EDIT BY TOMLINSON
; FIX ACBAS CHECK IN MSTKOV
;<133-TENEX>PISRV.MAC;96    13-SEP-74 16:44:00    EDIT BY ALLEN
; FIX BUG IN MEMORY PARITY SCAN
;<133-TENEX>PISRV.MAC;95    16-AUG-74 11:49:52    EDIT BY ALLEN
; PUT IN MISSING INSTRUCTION IN MEM PARITY SCAN
;<TENEX-132>PISRV.MAC;94    16-JUN-74 22:16:32    EDIT BY CLEMENTS
;<TENEX-132>PISRV.MAC;93    20-MAY-74 11:15:27    EDIT BY ALLEN
;<TENEX-132>PISRV.MAC;92    16-MAY-74 14:19:31    EDIT BY ALLEN
;ADD CHECK FOR UNEXPECTED NXM IN PARITY ERROR MEMORY SCAN.
;<TENEX-132>PISRV.MAC;91    30-MAR-74 18:16:54	EDIT BY CLEMENTS
;<TENEX-132>PISRV.MAC;90    29-MAR-74 19:43:32	EDIT BY CLEMENTS
;<TENEX-132>PISRV.MAC;89     9-MAR-74 15:03:12	EDIT BY CLEMENTS
; CLEAR IDX FIELD OF FPC AT MRETN
;<TENEX-132>PISRV.MAC;88    22-FEB-74 14:54:44	EDIT BY ALLEN
; NEW CODE FOR BUG NOTES
;<TENEX-132>PISRV.MAC;87    24-NOV-73 00:39:21	EDIT BY CLEMENTS
;<TENEX-132>PISRV.MAC;86    23-NOV-73 18:44:20	EDIT BY CLEMENTS
;<TENEX-132>PISRV.MAC;85    23-NOV-73 16:49:11	EDIT BY CLEMENTS
;<TENEX-132>PISRV.MAC;84    23-NOV-73 16:25:00	EDIT BY CLEMENTS
;<TENEX-132>PISRV.MAC;83    23-NOV-73 14:39:04	EDIT BY CLEMENTS
;<TENEX-132>PISRV.MAC;82    10-NOV-73 19:57:38	EDIT BY CLEMENTS
;<TENEX-132>TPISRV.MAC;1     1-NOV-73 12:07:56	EDIT BY BTHOMAS
;<TENEX-132>PISRV.MAC;80     5-OCT-73 15:19:52	EDIT BY ALLEN
; UPDATE JOBRTT ON 1 MSEC TICK
;<TENEX-132>PISRV.MAC;79    30-AUG-73 22:02:26	EDIT BY ALLEN
;<TENEX-132>PISRV.MAC;78    29-AUG-73 13:23:56	EDIT BY ALLEN
; REPLACE APPROPRIATE RESKED'S WITH RESKD1'S TO AVOID UNNECESSARY
; WAITLIST SCANS
;<TENEX-132>PISRV.MAC;75    26-JUN-73 16:13:40	EDIT BY CLEMENTS
; SEPARATING ASSEMBLY OF PISRV FROM MON
;<TENEX-132>PISRV.MAC;74     5-APR-73 21:19:20	EDIT BY PLUMMER
; DAC: ON PI-1
;<TENEX-132>PISRV.MAC;73    26-MAR-73 22:08:11	EDIT BY PLUMMER
; PI-1 FOR ADC
;<TENEX-132>PISRV.MAC;72    13-FEB-73 18:37:40	EDIT BY CLEMENTS
; PATCHES AS DISTRIBUTED
;<TENEX-132>PISRV.MAC;71    22-JAN-73 13:00:23	EDIT BY TOMLINSON
;<TENEX-131>PISRV.MAC;69     9-JAN-73 14:31:07	EDIT BY CLEMENTS
;<TENEX-130>PISRV.MAC;68     2-DEC-72 18:26:31	EDIT BY CLEMENTS
;<TENEX-130>PISRV.MAC;67    20-NOV-72 14:57:23	EDIT BY TOMLINSON
; REMOVED BGHERE
;<TENEX-130>PISRV.MAC;66    20-NOV-72 13:31:49	EDIT BY WALLACE
;<TENEX-130>PISRV.MAC;65    10-NOV-72  0:19:12	EDIT BY TOMLINSON
; CHANGED BGHERE USAGE
;<TENEXDLM>PISRV.MAC;64     7-AUG-72 21:48:57	EDIT BY MURPHY
;26 JUN 72, 1729:

;PI DISPATCH MODULE - D. MURPHY

SEARCH PROLOG

TITLE PISRV

;SYSTEM INITIALIZATION

;LINKAGE TO PAGEM AND SCHED

EXTERN APCLK1,BHC,DISKP,FORKX,INSKED,ISKED,PSKED,ITRAP,ITRAP1
EXTERN JB0FLG,JOBSRT,LSTERR,MMSPTN,MPEINT,P7FOV,P7OV,P7POV
EXTERN PGRINI,PGRRST,PGRTRP,PI7P,PISC7,PWRDWN,SCDIN,SCDRQ,SCDRQ7
EXTERN SCDVE,SCHED0,SKEDF1,SWPCOR,SWPRST,SYNCC,TADSEC,TODCLK,JOBRTT
EXTERN SETMPG,SCDRN1

IFN KIFLG,<
EXTERN KXUPT
ACPSB==EUACB-UACB-20		; [ISI] Def from KISRV
EXTERN KIASTK		;[ISI] KI STACK AREA
>

PGR==24		;PAGER DEVICE NUMBER
OAP==20		;1 MS CLOCK/ DOORBELL DEVICE NUMBER
;CELLS NOT CHANGED DURING DISK RELOAD OF RES MON

	EXTERN RCADDT,SAVE36,SAVE32
	EXTERN DIDSCI,DIDSCA
	INTERN DCHKSW,BUGADR,CHKADR
	INTERN SYSGO1,MSTKOV,SYSGO,SYSLOD,DBUGSW,GETSMF,CRSTAD,SYSRST
INTERN	ACFAIL,ILUUO,MEMPAR,OV0,OV1,UUOH1,UUOHK		;[ISI]

IFDEF I4SW,<
DMPSW1=31>		;DUMPSW SAVED WHILE RELOADING
DBUGS1=30		;DBUGSW SAVED WHILE RELOADING
CRSTD1=27		;CRASH TIME AND DATE SAVED WHILE RELOADING
BUGHAD=26		;BUGHLT AND CHK ADDRESSES SAVED WHILE RELOADING
;24 AND 25 USED BY DISK AT I4-TENEX. WE'LL SKIP THEM.

;*** DO NOT SEPARATE - A GETAB TABLE ***
DCHKSW=77	;NE 0 MEANS BREAK ON BUGCHKS
DBUGSW=76	;0=UNATTENDED, 1=ATTENDED, 2=DEBUGGING
;*** END OF "DBUGSW" GETAB TABLE ***
GETSMF=75	;MONITOR SAVED ON DSK IF NON-0
;SKIP OVER 74 WHICH IS JOBDDT IN DEC STUFF, MAKING ANNOYING CONFLICTS
CRSTAD=73	;TIME AND DATE SAVED ON LAST AUTO-RESTART

;MANUAL START TRANSFER VECTOR

	LOC 140
	0			;EDDT - SET BY POSTLD
	JRST SYSRST		;RESTART
	JSR BUGHLT		;WAY TO CRASH SYSTEM FROM SWITCHES
	0
	0
	0
	JRST SYSGO		;106/ RELOAD AND START
	JRST SYSGO1		;107/ START
;LOC'S 110 AND 111 USED BY I4-TENEX DISK. SKIP THEM IF POSSIBLE.
	RELOC

;DEFINE APPROPRIATE SYMBOLS FOR EXISTENT DEVICES

IFDEF DSKCHN,<	INTERN DSKCHN,DSKCHR
	EXTERN DSKINI,DSKRST,DSKSV>
IFDEF DRMCHN,<	INTERN DRMCHN,DRMCHR
	EXTERN DRMINI,DRMRST,DRMSV>
IFDEF MTACHN,<	INTERN MTACHN,MTDCHN,MTACHR
	EXTERN MTASV,MTARST>
IFDEF SSACHN,<	INTERN SSACHN,SSACHR
	EXTERN SSAINI,SSASV,SSARST>
IFDEF LPTCHN,<	INTERN LPTCHN,LPTCHR
	EXTERN LPTSV,LPTRST>
IFDEF DSPCHN,<	INTERN DSPCHN,DSPCHR
	EXTERN DSPSV,NRUNG,DSPCNT,DSPRSK,DSPRST>
IFDEF DTACHN,<	INTERN DTACHN,DTDCHN,DTACHR
	EXTERN DTASV,DTARST>
IFDEF PTRCHN,<	INTERN PTRCHN,PTRCHR
	EXTERN PTRSV,PTRRST>
IFDEF PTPCHN,<	INTERN PTPCHN,PTPCHR
	EXTERN PTPSV,PTPRST>
IFDEF PLTCHN,<	INTERN PLTCHN,PLTCHR
	EXTERN PLTSV,PLTRST>
IFDEF DLSCHN,<	INTERN DLSCHN,DLSCHR
	EXTERN TTINIT,TTRSET,DLSSV,TTNIT1>
IFDEF IMPCHN,<	INTERN IMPCHN,IMPCHR
	EXTERN IMPSV,IMPRST>
IFDEF DACCHN,<
	INTERN DACCHR,DACCHN
	EXTERN DACSV,DACRST>
IFDEF ADCCHN,<
	INTERN ADCCHR,ADCCHN
	EXTERN ADCSV,ADCRST>
IFDEF VTCCHN,<
	INTERN	VTCCHN,VTCCHR
	EXTERN	VTCSV,VTCRST
>

;START FROM SCRATCH AFTER DECTAPE LOADING

SYSGO:
START::
SYSGO1:	SKIPA 7,DIDSCI
SYSLOD:	SETZ 7,			;CLEAR DIDSCA TO RELOAD DISK
	MOVE P,PI7P
	CONO APR,200000		;RESET IO DEVICES
	CONO PI,610000		;RESET PI
	SETZM CRSTD1
	MOVE 1,[XWD 5000,5000+1]
	SETZM -1(1)
	BLT 1,SCDVE
	MOVEM 7,DIDSCA
	SKIPE 1,CRSTAD		;HAVE SAVED PRE-CRASH INFO?
	MOVE 1,BUGHAD		;YES, RESTORE CELLS
	HRRZM 1,BUGHLT
	HLRZM 1,BUGCHK
	AOS INSKED
	MOVE 1,[JRST BUGH9]	;SETUP JSR DISPATCHES
	MOVEM 1,BUGHLT+1
	MOVE 1,[JRST BUGC9]
	MOVEM 1,BUGCHK+1
	MOVE 1,[JRST BUGN9]
	MOVEM 1,BUGNTE+1
IFDEF I4SW,<
	CALL I4INI>		;INITIALIZE I4-SPECIFIC STUFF
IFN KIFLG,<			;[ISI]
	CALL PAGRST## >		;[ISI] Init KI pager
	CALL RESFPI##		;Init resident free pool
	CALL PGRINI		;INIT DST, CST, ETC.
	IFDEF DRMCHN,<CALL DRMINI>		;DRUM
	IFDEF DSKCHN,<CALL DSKINI>		;DISK
	IFDEF DLSCHN,<CALL TTINIT>		;TELETYPE MODULE
	IFDEF SSACHN,<CALL SSAINI>	;IBM DEVICE CONTROLLER
	IFN DK10F,<CALL DK10IN>		;DK10 CLOCK
	CALL SCDIN		;SCHEDULER
	CALL PIINIT		;PI MODULE - LAST INIT
	MOVE 1,[XWD CTYLIN,JOBSRT]
	CALL SCDRQ7		;INITIATE FIRST JOB
	JRST SCHED0		;TO SCHEDULER

;RESTART SYSTEM

	DEFINE DEVRST (A)
<	IFDEF A'CHN,<CALL A'RST>>

SYSRST:	MOVE P,PI7P
	CONO APR,200000
	CONO PI,410000
	SETZM PWRDWN
	SETOM SCDRN1		;IN CASE ONLY ONE JOB WAS RUNNING.
	CALL PGRRST
	CALL TTRSET
	DEVRST ADC
	DEVRST DAC
	DEVRST SSA
	DEVRST DRM
	DEVRST DSK
	DEVRST MTA
	DEVRST LPT
	DEVRST DSP
	DEVRST DTA
	DEVRST PTR
	DEVRST PTP
	DEVRST PLT
	DEVRST IMP
	DEVRST VTC
	IFN DK10F,<CALL DK10IN>	;RESTART DK10 CLOCK
	PUSH P,INSKED
	MOVEI 1,1
	MOVEM 1,INSKED
	SETZM SKEDF1
	SETZM SYNCC
	CALL PIINIT
	CALL SWPRST		;SWAPPER CLEANUP
	POP P,1
	JUMPN 1,SCHED0		;RESUME SCHED IF THERE AT CRASH
	SETZM INSKED
	SETOM TRAPC
	MOVSI 1,UMODF		;CRASH PROCESS RUNNING AT CRASH
	MOVEM 1,FPC
	JRST ITRAP
IFN DK10F,<
DK10IN:	CONO CLK,1B26		;CLEAR CLOCK
	CONSZ CLK,1B26		;IS IT RUNNING ON ITS CRYSTAL LIKE IT SHOULD?
	RET			;NO. CAN'T USE. SOMEONE DIDDLED THE SWITCHES.
	DATAO CLK,[^D100]	;OK. SET FOR 1 MS INTERVAL (100*10 USEC)
	CONO CLK,1B27+1B30+APRCHN ;TURN ON CLOCK AND PI, CLEAR "USER TIME" FLAG
	RET
>

;IMPOSSIBLE SITUATION HALT

	EXTERN BUGTYO,BUGMSG,EXBUGH,TADDAY

LS BUGHLT,2
LS SYMPRS,1		;MONITOR SYMBOL TABLE PRESENT FLAG
LS DDTPRS,1		;DDT PRESENT FLAG

BUGH9:	SOS BUGHLT
	exch 1,bughlt		;get bughlt pc, save ac1
	movem 1,yhcrsh##	;inform tymbase about cause of death
	exch 1,bughlt		;restore all
	SKIPE DBUGSW		;DEBUG MODE?
BUGH0:	SKIPE DDTPRS		;YES, DDT IN CORE ?
	CAIA			;NO
BUGADR:	JRST 4,@BUGHLT		;YES
	AOS JB0FLG		;GET IT REPORTED SOON
	SKIPN INSKED		;IN SCHEDULER?
	CONSZ PI,177B27		;OR IN PI?
	JRST .+2
	JRST EXBUGH		;NO, CRASH THIS JOB
	PIOFF			;TURN OFF SYSTEM
	MOVEI 1,[SIXBIT '$BUGHLT AT /']
	JSR BUGMSG		;TYPE CRASH MESSAGE
	HRLZ 2,BUGHLT
	MOVEI 3,6		;TYPE 6 DIGITS
BUGH1:	SETZ 1,
	LSHC 1,3
	ADDI 1,"0"
	JSR BUGTYO
	SOJG 3,BUGH1
	MOVEI 1,[SIXBIT '$/']
	JSR BUGMSG
	movei a,22		;control-r
	jsr bugtyo		;turn on bell to alert operator
	jrst 4,@bughlt		;this here is the bitter end, folks...

;LESS SERIOUS HALT

LS BUGCHK,2

BUGC9:	SKIPE DCHKSW		;DEBUG MODE?
	SKIPE DDTPRS		;YES, DDT IN CORE ?
BUGC0:	CAIA			;NO
CHKADR:	JFCL			;YES, BREAKPOINT HERE
	AOS JB0FLG		;GET IT REPORTED
	JRST @BUGCHK		;CONTINUE

;LEAST SERIOUS ERROR -- DON'T HALT, JUST GET IT REPORTED.

LS BUGNTE,2

BUGN9:	AOS JB0FLG
	JRST @BUGNTE

;PI SYSTEM INITIALIZATION

IFN KAFLG!F3FLG,<
PIINIT:	MOVSI 1,(JSYS)		;SETUP JSYS DISPATCHES IN LOWER CORE
	MOVSI 3,-NPISET
PII1:	HRR 1,PISETT(3)		;DISPATCH ADDRESS WITH JSYS
	HLRZ 2,PISETT(3)	;LOC OF WHERE IT GOES
	MOVEM 1,0(2)
	AOBJN 3,PII1
	CONO APR,473550+APRCHN	;SET APR FLAGS
	CONO PI,642200+177	;CLEAR FLAGS, SET CHANNELS ON
	RET
>

IFN KIFLG,<			;[ISI]
EXTERN	PIINIT			;[ISI]
>

;IMAGE OF LOW CORE PI LOCS

	DEFINE PILC (C,A)
<	XWD 40+2*C,A>

PISETT::PILC 1,PISC1		;DAC AND ADC
	PILC APRCHN,PIAPR	;APR CHANNEL
	PILC 4,PISC4		;GENERAL CHANNELS
	PILC 5,PISC5
	PILC 6,PISC6
	PILC 7,PISC7
IFN KAFLG!F3FLG,<
	XWD 41,UUOH		;UUO'S AND ILLEG. INSTR'S
	XWD 61,UU60		;UNIMPLEMENTED INSTR'S
	XWD 70,PGRTRP		;PAGER TRAP
>
NPISET==:.-PISETT

LS PIAPRX,<1*KAFLG>+<2*KIFLG>+<2*KLFLG>+<1*F3FLG>
LS PI1AC1,1

LS PISC5R,<1*KAFLG>+<2*KIFLG>+<2*KLFLG>+<1*F3FLG>
LS PI5AC,5

;CHANNEL DISPATCH ROUTINES

;CHANNEL 1, RTI DISPATCH
PISC1:	PI1R,,.+1
	MOVEM 1,PIRTI1
	MOVEM 2,PIRTI2
	IFDEF ADCCHN,<JSYS ADCSV>
	IFDEF DACCHN,<JSYS DACSV>
DACCHR:
ADCCHR:	MOVE 2,PIRTI2
	MOVE 1,PIRTI1
	JRST 12,@PI1R

LS PI1R,<1*KAFLG>+<2*KIFLG>+<2*KLFLG>+<1*F3FLG>
LS PIRTI1,1
LS PIRTI2,1


PIAPR:	XWD PIAPRX,.+1
	SOMSCK			;1 MS CLOCK TICKED?
	JRST PIAPR1		;NO
	MSCKCL			;YES. CLEAR THE HARDWARE FLAG
	sosg syncc		;time to sync?
	jrst mscjnk		;yes, go check for screwup

msctik:	aos todclk		;no, update main clock
	aos jobrtt		;and that of running job
	jen @piaprx

mscjnk:	msckof			;turn off clock
	skipl syncc		;last tick??
	jrst msctik		;yes, go update clocks
	jen @piaprx		;no, msckof failure, don't aos clocks

PIAPR1:	CONSZ APR,1B26		;60 CY CLOCK
	JRST APCLK1
IFN KIFLG,<
	JRST PIAPR2##>		;FLAG HANDLER IN SEPARATE MODULE
IFN KAFLG!F3FLG,<
	MOVEM 1,PI1AC1
	CONSZ APR,1B21		;ADR BRK?
	JRST ADRBK
	CONSZ APR,1B19		;PDL OVF
	JRST P1POV
	CONSZ PI,1B18		;PWR FAIL?
	JRST ACFAIL		;YES
	SKIPN DEVMPE		;DEVICE DETECTED MPE?
	CONSZ PI,1B19		;PARITY ERROR?
	JRST MEMPAR		;YES
	CONSZ APR,1B23+1B22	;NXM, MEM PROT
	JRST P1NXM
	CONI APR,1		;OV OR FOV
	TRC 1,3B29+3B32
	TRNN 1,3B29		;FOV AND FOV ENABLED
	JRST P1FOV
	TRNN 1,3B32		;OV AND OV ENABLED
	JRST P1OV
	JRST OV0		;NOTHING, DEBREAK

;STILL IN KA-10 CONDITIONAL
;ADDRESS BREAK, ASSUMED TO BE USED ONLY FOR WRITE INTO RESIDENT
; EXEC VIRTUAL ADDRESS SPACE. THE REASONS FOR THE RESTRICTIONS ARE:
;	VIRTUAL - BECAUSE THAT IS WHAT THE HARDWARE CHECKS
;	EXEC - BECAUSE IT IS TOO DIFFICULT TO DISTINGUISH WHETHER THE
;		TRAP IS ON A REFERENCE TO THE EXEC SPACE OR THE USER
;		SPACE (BECAUSE THE PC ISN'T DIRECTLY RELATED TO THE
;		INSTRUCTION PRODUCING THE REFERENCE, AND THE POSSIBLITY
;		OF A UMOVEM OR AN EXECUTIVE XCT INTO THE USER ADDRESS
;		SPACE) AND OUR REFERENCE TO THE WRONG SPACE COULD
;		CAUSE A PAGE FAULT
;	RESIDENT - BECAUSE A PAGE FAULT WOULD OCCUR IF THE TRAP WERE
;		CAUSED BY A REFERENCE TO THE USER SPACE AND THE
;		PAGE WITH THE SAME ADDRESS IN THE EXEC VIRTUAL ADDRESS
;		SPACE WAS NOT IN CORE
;	WRITE - BECAUSE THE METHOD OF DETERMINING WHICH ADDRESS SPACE
;		WAS REFERENCED IS TO SEE IF THE CONTENTS OF THE WORD
;		(IN EXEC VIRTUAL ADDRESS SPACE) HAS CHANGED


ADRBK:	MOVE 1,@ADRBKA		;GET CURRENT VALUE OF CHECKED WORD
	CONO APR,1B21+APRCHN	;CLEAR ADR BRK FLAG
	SKIPN ADRBKF		;INITIALIZED YET?
	JRST ADRBKI		;NO. GO INITIALIZE
	CAMN 1,ADRBKW		;HAS WORD (IN EXEC SPACE) CHANGED?
	JRST OV0		;NO. (MIGHT BE WRITE INTO USER SPACE.)
	MOVEM 1,ADRBKW		;YES. NOTE NEW VALUE

	; INSERT TEST OR CHECK ROUTINE HERE

	JRST OV0		;DISMISS THE ADDRESS BREAK TRAP

ADRBKI:	SETOM ADRBKF		;SET "INITIALIZED" FLAG
	MOVEM 1,ADRBKW		;NOTE VALUE OF WORD TO BE CHECKED
	JRST OV0		;DISMISS THE ADDRESS BREAK TRAP

LS ADRBKA,1			;ADDRESS OF WORD TO BE CHECKED
LS ADRBKF,1			;0 = NOT INITIALIZED, -1 = INITIALIZED
LS ADRBKW,1			;LAST VALUE SEEN IN WORD TO BE CHECKED

;STILL IN KA-10 CONDITIONAL
;OVERFLOWS

P1FOV:	TRNN 1,3B32		;OV ENABLED TOO?
	SKIPA 1,[1B0+1B3]	;YES, CLEAR OV AND FOV FLAGS
	MOVSI 1,(1B3)		;NO, CLEAR FOV ONLY
	ANDCAM 1,PIAPRX		;CLEAR FLAG CAUSING INTERRUPT
	MOVEI 1,P7FOV
	JRST FOV1

P1OV:	MOVSI 1,(1B0)
	ANDCAM 1,PIAPRX		;CLEAR FLAG
	MOVEI 1,P7OV
FOV1:	SKIPN INSKED		;IGNORE IF: IN SCHED, OR
	CONSZ PI,177B27-1B<APRCHN+20> ;IN PI SERVICE
	JRST OV0
	JFCL 17,.+1		;CLEAR FLAGS
	HLL 1,PIAPRX
	TLNN 1,UMODF		;IF IN USER MODE, OR
	SKIPE OVFLG		;IN MONITOR WITH FLAG SET,
	JRST OV1
	HRL 1,PIAPRX
	TLC 1,PGRTRP+1
	TLNE 1,-1		;CAME FROM FIRST INSTRUCTIONOF PGR TRP?
	JRST OV0		;NO
	HLL 1,TRAPPC		;YES, SO REAL PC IS THERE
	TLNE 1,UMODF		;IS THAT USER?
	JRST OV1		;YES, REQUEST INTERRUPT
	JRST OV0

;STILL IN KA-10 CONDITIONAL
P1NXM:	CONSZ APR,1B22		;MEM PROT?
	JRST P1PRT		;YES
	BUG(CHK,<NXM DETECTED BY PROCESSOR>)
	CONO APR,1B23+APRCHN	;THEN CLEAR FLAGS
	MOVE 1,PIAPRX
	TLNN 1,UMODF		;USER PC?
	BUG(HLT,<FATAL XNM>)
	MOVEI 1,MPEINT		;GIVE USER MPE INTERRUPT
	JRST OV1

P1PRT:	BUG(CHK,<MEM PROT VIOL REPORTED BY PROCESSOR>)
	DATAO APR,[XWD 776776,0] ;RESET IT IN CASE WAS CLEARED RANDOMLY
	CONO APR,1B22+APRCHN	;CLEAR FLAG
	JRST OV0		;AND PROCEED

P1POV:	CONO APR,1B18+APRCHN	;CLEAR FLAG
	MOVE 1,PIAPRX
	TLNN 1,UMODF		;FROM MONITOR?
	JRST P1SOV
P1UPOV:	MOVEI 1,P7POV
	JRST OV1

P1SOV:	MOVEI 1,0(1)
	CAIE 1,PGRTRP+1		;FROM PAGER TRAP STARTING?
	JRST P1MSOV		;NO, REAL MSOV
	MOVE 1,TRAPPC		;MEM TRAP AS WELL AS SOV, GET PC
	TLNE 1,UMODF		;THIS ONE USER?
	JRST P1UPOV		;YES
P1MSOV:	MOVE 1,PI1AC1
	JEN @[MSTKOV]
>; END OF KA-10 PROCESSOR CONDITIONAL CODE

OV1:	HRL 1,FORKX
	JSR SCDRQ		;REQUEST SCHEDULER ACTION
	RESKD1
OV0:	MOVE 1,PI1AC1
	JEN @PIAPRX

MSTKOV:	CONSO PI,177B27		;BAD ONE?
	SKIPE INSKED
	BUG(HLT,<PDL OVERFLOW IN SCHEDULER OR WHILE PI IN PROGRESS>)
	BUG(CHK,<PDL OVERFLOW IN MONITOR>)
	SETOM TRAPC		;NOT SO BAD
	MOVE	P,UPP			;GET A REASONABLE STACK
	ADD	P,BHC+2
	MOVEM	P,MPP
	PUSH	P,1
	MOVE 1,ACBAS		; WHERE IS CURRENT AC BLOCK?
	CAIL	1,<EUACB>B39		;AC BLOCKS IN PSB?
	JRST	MSTKV2			;NO, ADJUST UACPG MAP ENTRY
MSTKV1:	POP	P,1
	MOVE	P,ACBAS1
	MOVEM	P,ACBAS
	SETACB	P
	SETZM	SLOWF
	MOVE	P,MPP
	JRST	ITRAP

MSTKV2:	PUSH	P,2
	SETZ	1,
	MOVEI	2,UACPGA
	CALL	SETMPG			;UNMAP AC BLOCK PAGE
	POP	P,2
	MOVE	1,PSB+PSBPG
	MOVEM	1,PSB+UACPG		;SET MAP ENTRY FOR UACPG TO PSB
	JRST	MSTKV1

;AC FAIL

ACFAIL:	CONO PI,1B18		;CLEAR FLAG
	AOS PWRDWN		;SET FLAG TO NOTIFY SCHED
	RESKD1			;NOW
	JRST OV0

;MEMORY PARITY ERROR DETECTED

MEMPAR:	PIOFF
	MOVEM 7,MEMPA+7		;SAVE SOME AC'S
	MOVEI 7,MEMPA
	BLT 7,MEMPA+6
	CONO PI,1B19+1B20	;CLEAR PAR FLAG AND DISABLE INTERRUPT
	MOVEI 1,[SIXBIT '$MPE DETECTED BY /']
	JSR BUGMSG
	MOVE 6,[SIXBIT ', PC=/']
	SKIPN 5,DEVMPE		;MESSAGE LEFT BY DEVICE?
	MOVE 5,[SIXBIT 'APR']	;NO, SAY APR
	MOVEI 1,5		;STRING IN 5-6
	JSR BUGMSG
	HRRZ 1,PIAPRX
	JSP 4,BUGOPT
	MOVEI 1,[SIXBIT ', MONITOR/']
	MOVSI 2,UMODF
	TDNE 2,PIAPRX
	MOVEI 1,[SIXBIT ', USER/']
	JSR BUGMSG
	MOVEI 1,[SIXBIT '$ LOCATN    CONTENTS$/']
	JSR BUGMSG
	SETZB 6,MEMPA+1		;CLEAR COUNTERS FOR ERRORS AND BAD ERRS
	MOVSI 1,RWXB		;READ, WRITE, EXECUTE, ACCESS ALLOW
	EXCH 1,MMAP+CSWPG	;USE CSWPG TO TEST ALL OF CORE
	MOVEM 1,MEMMAP		;SAVE PRESENT CONTENTS OF MMAP FOR CSWPG
	MOVEI 3,0		;START SCAN AT PHYSICAL PAGE ZERO
MEMP3:	HRRM 3,MMAP+CSWPG	;NOW MAP THE NEXT PAGE THROUGH CSWPG
	MOVSI 1,(400B8)		;SET AN AGE WHICH WON'T CAUSE A TRAP
	EXCH 1,CST0(3)		;
	MOVEM 1,MEMCST		;SAVE THE CURRENT CST0 ENTRY
IFN KAFLG!F3FLG,<
	MONCLR (CSWPG)		;CLEAR THE AR'S USED FOR CSWPG
>
IFN KIFLG,<			;[ISI] Set up KI's page table directly
	MOVEI 1,KIAXB+KIWB(3)	;[ISI]  and have the pager take a fresh
	MONSET (CSWPG,1,2)	;[ISI]  look at things
	DATAO PAG,KIPGWD##	;[ISI]
>
	MOVSI 2,-1000		;SET TO SCAN ONE FULL PAGE
MEMP2:	MOVE 0,CSWPGA(2)	;REFERENCE THE LOCATION
	CONSZ APR,APNXM		;NXM?
	JRST MEMP9		;YES
IFN KAFLG!F3FLG,<		;[ISI]
	CONSZ PI,1B19>		;[ISI] MPE IN THIS LOCATION?
IFN KIFLG,<			;[ISI]
	CONSZ APR,1B19>		;[ISI] MPE IN THIS LOCATION?
	JRST MEMP1		;YES, GO REPORT IT
MEMP4:	AOBJN 2,MEMP2		;DONE ALL OF THIS PAGE?
MEMP12:	MOVE 1,MEMCST		;YES.
	MOVEM 1,CST0(3)		;RESTORE PREVIOUS AGE AND PUR INFO
	CAIGE 3,MAXCOR-1	;DONE ALL OF CORE?
	AOJA 3,MEMP3		;NO, DO NEXT PAGE
	MOVE 1,MEMMAP		;YES. RESTORE MMAP ENTRY FOR CSWPG
	MOVEM 1,MMAP+CSWPG
	MONCLR (CSWPG)		;CLEAR THE AR'S FOR CSWPG
	MOVEI 1,[SIXBIT '$/']
	SKIPN 6			;IF NO DETECTED ERRORS,
	MOVEI 1,[SIXBIT '$NONE FOUND$/'] ;SAY SO
	JSR BUGMSG		;TYPE EOL
	CONO PI,1B21		;RE-ENABLE MPE INTERRUPT
	MOVSI 7,MEMPA		;RESTORE AC'S
	BLT 7,7
	PION
	BUG(HLT,<MEMORY PARITY ERROR>)

;HERE ON NXM DURING MEMORY SCAN
MEMP9:	LDB 1,[POINT 6,MEMCST,5]	;SHOULD THIS NXM HAVE OCCURRED?
	CAIN 1,1
	 JRST MEMP11			;YES, IT IS OK
	MOVEI 1,[SIXBIT '$UNEXPECTED NXM DURING PARITY ERROR SCAN AT /']
	JSR BUGMSG
	JSP 4,ADROPT			;TYPE OUT THE ADDRESS
	MOVEI 1,[SIXBIT '$CHECK POWER ON ALL MEMORIES.$/']
	JSR BUGMSG
	BUG(HLT,<UNEXPECTED NXM DURING PARITY ERROR SCAN>)
MEMP11:	CONO APR,APNXM+APRCHN		;CLEAR NXM FLAG
	JRST MEMP12			;GO SCAN THE NEXT PAGE

;FOUND MEM PAR ERR ON DIRECT REFERENCE

MEMP1:	MOVEM 0,CSWPGA(2)	;REWRITE WORD TO ELIMINATE MPE
	ADDI 6,1		;COUNT ERRORS
	CONO PI,1B19		;CLEAR FLAG
	CAIL 6,20		;REPORTED A LOT ALREADY?
	JRST MPEX1		;YES, QUIT REPORTING THEM
	MOVEI 1," "
	JSR BUGTYO
	JSP 4,ADROPT		;TYPE ADDRESS
	MOVEI 1," "
	JSR BUGTYO
	HLRZ 1,CSWPGA(2)
	JSP 4,BUGOPT		;TYPE LH OF BAD WORD
	MOVEI 1,","
	JSR BUGTYO
	HRRZ 1,CSWPGA(2)
	JSP 4,BUGOPT		;TYPE RH OF BAD WORD
	MOVEI 1,[SIXBIT '$/']	;TYPE EOL
	JSR BUGMSG
MPEX1:	CAMGE 3,SWPCOR		;IS THE ERROR IN THE RESIDENT MONITOR?
	JRST MEMP5		;YES. TOO BAD, BUT DEFINITELY FATAL!
	MOVSI 1,SWPERR		;NO. MARK ERROR IN PAGE
	IORM 1,CST3(3)
	MOVE 1,CST2(3)		;OWNER
	TLNE 1,-1		;SPT?
	JRST MEMP6		;NO
	CAIGE 1,NOFN		;YES, INDEX BLOCK
	JRST MEMP5		;DANGEROUS TO HAVE BAD XB'S AROUND
	MOVE 1,SPTH(1)		;GET OWNER
	JUMPE 1,MEMP5		;DANGEROUS TO HAVE BAD PT'S OR PSB'S
MEMP6:	HLRZ 1,1		;OWNING PT
	CAMN 1,MMSPTN		;MON MAP?
MEMP5:	AOS MEMPA+1		;COUNT FATAL ERRORS
	JRST MEMP4		;CONTINUE CORE SCAN

LS MEMPA,10		;STORAGE FOR AC'S
LS MEMMAP,1		;STORAGE FOR THE MMAP ENTRY AT MMAP+CSWPG
LS MEMCST,1		;STORAGE FOR CST0 ENTRY FOR PAGE BEING SCANNED

GS DEVMPE,1		;NAME (IN SIXBIT) OF DEVICE REQUESTING CORE SCAN
LS PARTIM,1		;TIME OF LAST PAR ERR

;TYPEOUT AN ADDRESS ON CONSOLE TTY WHILE PI SYSTEM TURNED OFF

ADROPT:	HRLZI 0,"0"_^D9(3)	;PAGE NUMBER NOW IN LEFT HALF OF AC0
	ROTC 0,^D9	;SEVENTH DIGIT OF ADDRESS IS IN AC1 (IN ASCII)
	JSR BUGTYO	;GO TYPE OUT THE SEVENTH DIGIT OF THE ADDRESS
	HLRZ 1,0	;RH OF AC1 CONTAINS 9 RIGHTMOST BITS OF PAGE
	IORI 1,0(2)	;"OR" IN THE 9 RIGHTMOST BITS OF THE ADDRESS
			; AND NOW FALL THROUGH INTO THE BUGOPT ROUTINE

;TYPEOUT 6-DIGIT NUMBER ON CONSOLE TTY WHILE PI SYSTEM TURNED OFF

BUGOPT:	HRLO 0,1	;FALL THRU INTO THIS INSTRUCTION FROM ADROPT
BUGOP1:	SETZ 1,		;CLEAR OUT AC1 FOR THE NEXT DIGIT
	ROTC 0,3	;SHIFT THE NEXT DIGIT INTO AC1 (RIGHT ALIGNED)
	ADDI 1,"0"	;CONVERT THE DIGIT TO ASCII
	JSR BUGTYO	;NOW GO OUTPUT IT
	TRNE 0,-1	;HAVE ALL THE DIGITS BEEN OUTPUT?
	JRST BUGOP1	;NO. GO BACK FOR THE NEXT DIGIT
	JRST 0(4)	;YES. EXIT (FROM BOTH BUGOPT AND ADROPT)

IFDEF DTACHN,<INTERN DTABIT	;BIT FOR DTA CHANNEL IN CONO PI,
	DTABIT==1B<DTACHN+28>
>

;DISPATCHERS FOR PI CHANNELS 4 THRU 6
;ON KA-10 USE JSYS TO DISPATCH. ON KI-10, FAKE IT WITH A MACRO.

IFN KAFLG!F3FLG,<DEFINE DJSYS(XX)<	JSYS XX>>

IFN KIFLG,<DEFINE DJSYS(XX)<
	MOVE 4,XX
	HLRZ 3,4
	JSP 2,DJSYS0>

DJSYS0:	MOVEM 2,0(3)		;STORE PC WORD VIA LH OF E OF JSYS
	JRST 0(4)		;JUMP VIA RH OF E OF JSYS
>

PISC4:	XWD PI4R,.+1
	MOVEM 4,PI4AC+4
	MOVEI 4,PI4AC
	BLT 4,PI4AC+3
PISC41:	IFDEF DRMCHN,<DJSYS DRMSV>
	IFDEF DLSCHN,<DJSYS DLSSV>

DLSCHR:
DRMCHR:	 IFDEF DLSCHN,<
	 SKIPL TTNIT1		;MUST CHECK S'WARE FLAG SO ISB
	 JRST PISC41>		;DOESN'T GET LOST
	MOVSI 4,PI4AC
	BLT 4,4
	JEN @PI4R

LS PI4AC,5
LS PI4R,<1*KAFLG>+<2*KIFLG>+<2*KLFLG>+<1*F3FLG>

PISC5:	XWD PISC5R,.+1
IFN KAFLG!F3FLG,<		;CAN DO THIS WITHOUT SAVING ACS ON KA-10
	IFDEF IMPCHN,<JSYS IMPSV>	;MINIMUM OVERHEAD ON IMP
	IFDEF TNTCHN,<JSYS TNTSV##>	; TOO FOR TELENET INTERFACE
>
	MOVEM 4,PI5AC+4		;SAVE AC'S 0-4
	MOVEI 4,PI5AC
	BLT 4,PI5AC+3
IFN KIFLG,<			;MUST SAVE AC'S FIRST ON KI
	IFDEF IMPCHN,<DJSYS IMPSV>
>
	IFDEF DTACHN,<DJSYS DTASV>
	IFDEF SSACHN,<DJSYS SSASV>
IFNDEF SSADF,<
	IFDEF DSKCHN,<DJSYS DSKSV>>
IFNDEF SSATF,<
	IFDEF MTACHN,<DJSYS MTASV>>
	IFDEF PTRCHN,<DJSYS PTRSV>
IFN KIFLG,<IMPCHR:>
PTRCHR:
MTACHR:
DSKCHR:
DTACHR:
SSACHR:	MOVSI 4,PI5AC		;RETURN FROM DEVICE ROUTINES HERE
	BLT 4,4			;RESTORE AC'S 0-4
IFN KAFLG!F3FLG,<IMPCHR:>
	JRST 12,@PISC5R

PISC6:	XWD PI6R,.+1
	MOVEM 4,PI6AC+4
	MOVEI 4,PI6AC
	BLT 4,PI6AC+3
	IFDEF DSPCHN,<DJSYS DSPSV>
	IFDEF LPTCHN,<DJSYS LPTSV>
	IFDEF PTPCHN,<DJSYS PTPSV>
	IFDEF PLTCHN,<DJSYS PLTSV>
	IFDEF VTCCHN,<DJSYS VTCSV>
VTCCHR:
PLTCHR:
PTPCHR:
DSPCHR:
LPTCHR:	MOVSI 4,PI6AC
	BLT 4,4
	JRST 12,@PI6R

LS PI6R,<1*KAFLG>+<2*KIFLG>+<2*KLFLG>+<1*F3FLG>
LS PI6AC,5

	INTERN MENTR,MRETN,MONUUO,UJSYS,MRETNE,MRTNE1
	EXTERN GETPAT

UU60:	XWD FPC,.+1		;JSYS AT 61
	MOVEM T1,XMENTR
	HLRZ T1,60
	LSH T1,-^D9
	CAIE T1,133		;CHECK FOR IBP
	 JRST IUUO		;NO, GIVE TRAP
	MOVE T1,XMENTR		;SIMULATE ADJBP INSTRUCTION
	JSYS MENTR		;ENTER JSYS CONTEXT
	UMOVE T1,@60		;GET BYTE POINTER
	LDB T3,[POINT 6,T1,11]	;GET BYTE LENGTH
	MOVEI T2,^D36
	IDIVI T2,(T3)		;GET BYTES PER WORD
	LDB T3,[POINT 4,60,12]	;GET AC FIELD
	PUSH P,T3		;SAVE IT
	UMOVE T3,(T3)		;GET BYTE COUNT FROM USER
	IDIVI T3,(T2)		;GET NUMBER OF WORDS
	JUMPGE T4,.+3
	ADDI T4,(T2)		;MAKE POSITIVE
	SUBI T3,1
	ADDM T3,T1		;ADD TO BYTE POINTER
	SOJL T4,.+3
	IBP T1
	JRST .-2
	POP P,T3		;GET BACK USER AC FIELD
	UMOVEM T1,(T3)		;UPDATE BYTE POINTER
	JRST MRETN

IUUO:	MOVE 1,XMENTR		;RESTORE AC1
ILUUO:	JSYS MENTR
	ITERR ILINS1		;ILLEGAL UUO

;UUO DISPATCH

UUOH:	XWD FPC,.+1		;41 CONTAINS JSYS UUOH
	MOVEM 1,XMENTR		;SAVE AC1
	MOVE 1,FPC
	TLNE 1,UMODF		;USER CALL?
	JRST UUOHX		;YES
	MOVE 1,XMENTR
	BUG(CHK,<UUO FROM MONITOR>)
MONUUO:	JRST ILUUO

UUOHX:	HLRZ 1,40		;GET OP CODE
	LSH 1,-^D9
UUOHK:	CAIL 1,100		;OUT OF BOUNDS?
	JRST IUUO		;YES, ILLEGAL INSTRUCTION
	CAIL 1,40		;10/50 UUO?
	JRST UU1050		;YES
	JUMPE 1,IUUO		;0 IS ALWAYS ILLEG
	BUG(HLT,<01-37 UUO FROM USER MODE>)

REPEAT 0,<	;THIS WON'T BE USED UNLESS SOMEBODY WANTS
		;MON-MON OR USER-MON UUO'S INSTALLED
	SKIPL 1,UUOT(1)		;GET DISPATCH WORD, CHECK TYPE
	JRST UUOH2		;SLOW
	EXCH 1,XMENTR		;FAST, RESTORE AC1, SETUP DISPATCH ADR
	JRST @XMENTR		;COMMENCE ROUTINE
>

UU1050:	SKIPN PATADR		;GOT PAT NOW?
	JRST [	MOVE 1,XMENTR	;NO
		JRST GETPAT]	;GO GET IT
	MOVE 1,40		;MOVE STUFF FOR 10/50 COMPAT
	XCTUU PATU40		;CONTAINS UMOVEM 1,MONUUO
	MOVE 1,FPC
	XCTUU PATUPC		;CONTAINS UMOVEM 1,MONUPC
	MOVE 1,PATADR		;ENTRY VECTOR
	HRRM 1,FPC
	MOVE 1,XMENTR
	XCT MJRSTF

;ALL UNDEFINED JSYS'S

UJSYS:	JSYS MENTR
	ITERR ILINS2

;SLOW-CALL SETUP ROUTINE

MENTR:	XWD XMENTR,UUOH1	;SLOW JSYS'S BEGIN WITH  JSYS MENTR

UUOH2:	EXCH 1,XMENTR		;SLOW UUO'S ENTER HERE
UUOH1:	SETOM SLOWF
	EXCH 0,FPC		;GET RETURN PC
	TLNE 0,UMODF		;USER OR MONITOR MODE?
	JRST MENT1		;USER
	AOSGE INTDF		;INTDF ALLRIGHT?
	BUG(CHK,<AT MENTR - INTDF OVERLY DECREMENTED>)
	SOS INTDF
	PUSH P,INTDF
	PUSH P,MPP		;SAVE PREVIOUS ERRORSET
	PUSH P,0		;SAVE RETURN
	MOVEM P,MPP		;SAVE CURRENT STACK POINTER
IFN KIFLG,<
	MOVE P,ACBAS		;[ISI] SEE IF TIME TO SWAP FIRST SET OF
	CAIE P,<EUACB>B39-1	;[ISI] ACS OUT OT PAGE 775
	JRST MENT7		;[ISI] NO, CARRY ON
	SETZM UACPGA		;[ISI] TOUCH PAGE BEFORE NOSKED
	NOSKED			;[ISI]
	HRLZ P,KXUPT		;[ISI] WRITE ALL OF THE ACS CURRENTLY ON
	ADD P,[KIASTK+20,,0]	;[ISI] THE KI STACK TO PAGE 775 SO
	HRRI P,UACPGA		;[ISI] THAT THE PSB WILL BE AVAILABLE FOR
	BLT P,UACPGA+ACPSB-1	;[ISI] MORE AC BLOCKS
	OKSKED			;[ISI]
MENT7:
>
	AOS P,ACBAS		;GET NEXT AC BASE ADR
	CAIL P,<EUACB>B39	;USED ALL BLOCKS OF AC'S?
	JRST MENT4		;USED ALL AC BLOCKS IN PSB
MENT3:	SETACB P		;GIVE IT TO PAGER
MENT2:	MOVE 0,XMENTR		;LOCAL RETURN => FPC
	EXCH 0,FPC		;AC0 => 0
	SETZ P,
	XCTMU [BLT P,P-1]	;MOVE FROM REAL AC'S TO USER BLOCK
	MOVE P,MPP		;RESTORE P
	SETZM SLOWF
	XCT MJRSTF		;JRSTF @FPC  OR INTERRUPT

MENT1:	MOVEM P,XMENT1		;SAVE USER'S AC-P
IFN KIFLG,<
	MOVSI P,(1B6)		;CALL FROM MON FLAG
	IORM P,XMENTR>		;ENSURE CALL FROM USER IS SET ON KI10
	MOVE P,UPP		;GET STACK POINTER
	PUSH P,0		;TWO RETURNS
	PUSH P,0		;SO ONE CAN BE DIDDLED
	MOVEM P,MPP
	SETOM INTDF
	MOVE P,ACBAS1		;FIRST AC BASE TO USE
	MOVEM P,ACBAS
	SETACB P		;SET PAGER
	MOVE P,XMENT1		;RESOTRE USER'S AC-P
	UMOVEM P,P		;PUT USER'S AC-P WHERE IT BELONGS
	JRST MENT2

MENT4:
IFN KAFLG!F3FLG,<		;[ISI] DIFFERENT OVERFLOW CODE FOR KI
	CAIE	P,<EUACB>B39	;TIME TO SWITCH TO UACPG?
	JRST	MENT5		;NO, ALREADY SWITCHED
	MOVE	P,MPP		;YES, GET A PDL PTR
	SETZM	PSB+UACPG	;CLEAR MAP ENTRY FOR UACPG
	PUSH	P,1
	PUSH	P,2
	LDB	1,[POINT 13,PSB+PSBPG,26]
	MOVSI	2,RCW
	HRRI	2,UACPGA	;SET MAP ENTRY FOR UACPG TO
	CALL	SETMPG		;COPY WRITE PTR TO PSB
	POP	P,2
	POP	P,1
	MOVE	P,ACBAS
	JRST	MENT3		;SET UP PAGER
>				;[ISI]

MENT5:
IFN KAFLG!F3FLG,<		;[ISI]
	CAIL P,<EPSB>B39 >	;Any more AC blocks
IFN KIFLG,<			;[ISI]
	CAIL P,EKIASTK## >	;[ISI] KI AC stack shorter
	BUG(HLT,<MENTR - NO MORE AC BLOCKS>)
	JRST	MENT3

;SLOW-CALL RETURN

MRETNE:	MOVEM 1,LSTERR		;ERROR RETURN, SAVE ERROR CODE
	UMOVEM 1,1		;AND RETURN IT TO USER ALSO
MRTNE1:	CALL JSERT		;CHECK FOR ERJMP/ERCAL
	 JFCL			;RETURN WITH IT SET UP
MRETN:	SETOM SLOWF		;RESET FLAG
	AOSGE INTDF		;INTDF OK?
	BUG(CHK,<AT MRETN - INTDF OVERLY DECREMENTED>)
	MOVE P,MPP		;GET STACK POINTER AT LAST ENTRY
	POP P,0			;POP RETURN
	TLZ 0,37		;MAKE SURE NO CARRY INTO IDX FIELD
	MOVEM 0,FPC		;SETUP RETURN
	TLNN 0,UMODF		;USER MODE?
	JRST MRETN1		;NO
	SETZ P,
	XCTUM [BLT P,P]		;RESTORE USER AC'S
IFN KIFLG,<
	MOVEM P,XMENT1		;HAVE TO SET AC BLOCKS IN USER MODE
	SOS P,ACBAS		; TOO ON THE KI-10
	SETACB P
	MOVE P,XMENT1>
	XCT MJRSTF		;RETURN OR INTERRUPT

MRETN1:	MOVEM P,MPP		;SAVE P
	SETZ P,
	XCTUM [BLT P,P-1]	;RESTORE AC'S
	SOS P,ACBAS		;RESET AC BASE TO LAST ONE
	CAIGE P,<UACB>B39	;BEFORE BEGINNING OF AC BLOCKS?
	BUG(HLT,<MRETN - TRIED TO OVER-POP AC BLOCKS>)
	CAIN P,<EUACB-1>B39	;TRANSITION FROM UACPG TO PSB?
	JRST MRETN3		;YES
MRETN2:	SETACB P
	MOVE P,MPP
	POP P,MPP		;RESTORE PREVIOUS STACK POINTER
	POP P,INTDF		;RESTORE INTERRUPT DEFERRED STATE
	SETZM SLOWF
	XCT MJRSTF		;RETURN OR INTERRUPT

MRETN3:	MOVE P,MPP		;GET PDL PTR
	PUSH P,1
	PUSH P,2
IFN KIFLG,<
	TDN UACPGA		;[ISI] TOUCH PAGE BEFORE NOSKED
	NOSKED			;[ISI] THE KI STACK MIGHT DISAPPEAR IF SCHEDULED
	HRRZ 1,KXUPT		;[ISI] MOVE AC BLOCKS SAVED IN PAGE 775
	ADDI 1,KIASTK+20	;[ISI] BACK TO KI STACK.  FIRST BLOCK IS
	HRRZ 2,KXUPT		;[ISI] ALWAYS KEPT IN PSB SO KISLOD CAN GET
	HRLI 1,UACPGA		;[ISI] AT IT.
	BLT 1,KIASTK+ACPSB+17(2) ;[ISI]
	OKSKED			;[ISI] INTERRUPTED
>
	SETZ 1,
	MOVEI 2,UACPGA
	CALL SETMPG		;UNMAP UACPG
	MOVE 1,PSB+PSBPG	;AND THEN RESET MAP ENTRY
IFN KIFLG,<
	SETZ 1,			;[ISI] THE KI WANTS IT NOT MAPPED
>
	MOVEM 1,PSB+UACPG	;TO BE SAME AS FOR PSB
	POP P,2
	POP P,1
	MOVE P,ACBAS		;GET AC BLOCK ADDR
	JRST MRETN2


; Check for special JSYS error return instruction (ERJMP/ERCAL)
; Call:    call jsert
; Return:  +1, ERJMP/ERCAL return set up
;          +2, no ERJMP/ERCAL handling
jsert::	push p,1		; Save ac's
	push p,2
	push p,3
	push p,4
	move 1,mpp		; 1 _ stack ptr for JSYS entry frame
	move 2,0(1)		; 2 _ JSYS pc + 1
	umove 3,0(2)		; 3 _ instr after JSYS
	hlrz 4,3		; 4 _ op code
	cain 4,(<erjmp>)	; ERJMP?
	 jrst jsert0		; Yes
	caie 4,(<ercal>)	; ERCAL?
	 jrst jsert1		; No
	move 4,bhc+1		; Yes, fake call through user's stack
	xctuu [addb 4,p]
	tlnn 4,-1		; Stack overflowed?
	 jrst jserte		; Yes
	hrri 2,1(2)		; a _ ercal return pc
	umovem 2,0(4)		; Save on caller's stack
jsert0:	hrrm 3,0(1)		; Install new JSYS return adr
	skipa
jsert1:	 aos -4(p)		; No ERJMP/ERCAL, skip return
	pop p,4			; Recover ac's
	pop p,3
	pop p,2
	pop p,1
	ret

; Here for ERCAL stack overflow
jserte:	movei 1,^d9		; Cause interrupt on channel 9
	jrst itr4##

REPEAT 0,<	;NOT USED UNLESS MON-MON OR USER-MON UUO'S INSTALLED

;UUO DISPATCH TABLE

	DEFINE UUD (N,T)
<	EXTERN N
	XWD T*400000,N>

UUOT:	REPEAT 40,<XWD 400000,ILUUO>

	REPEAT 40,<XWD 0,GETPAT> ;LOADS 10/50 COMPATIBILITY
>

; *****
; The following junk supports macros in TOPS20 flavored modules
; *****

; Support for TRVAR, STACKL macros.

.TRSET::PUSH P,P6		; Save AC for stack pointer
	MOVE P6,P		; Set frame pointer
	ADD P,0(CX)		; Allocate space
	JUMPGE P,MSTKOV		; Handle stack overflow
	CALL 1(CX)		; Call rest of caller
.TRRET:: CAIA			; He wants no-skip return
	AOS -1(P6)		; He wants a skip return
	MOVEM P6,P		; Get back old stack
	POP P,P6		; And old frame
	RET

; Support routine for ASUBR macro.

.ASSET::PUSH P,P6		;SAVE AC FOR STACK POINTER
	MOVE P6,P		;SETUP FRAME PTR
	ADJSP P,4		;ALLOCATE SPACE
	DMOVEM T1,1(P6)		;SAVE ARGS
	DMOVEM T3,3(P6)
	PUSHJ P,0(CX)		;CONTINUE ROUTINE
.ASRET:: JRST [	MOVEM P6,P	;NO-SKIP RETURN, CLEAR STACK
		POP P,P6
		RET]
	MOVEM P6,P
	POP P,P6
	AOS 0(P)
	RET

; Support for STKVAR macro.

.STKST::ADD P,0(CX)		; Bump stack for variables used
	JUMPGE P,MSTKOV		; Test for stack overflow
	PUSH P,0(CX)		; Save block size for return
	PUSHJ P,1(CX)		; Continue routine, exit via .+1 OR .+2
.STKRT:: JRST STKRT0		; Non-skip return comes here
	POP P,CX		; Skip return comes here; recover count
	SUB P,CX		; Adjust stack to remove block
	AOS 0(P)		; Now do skip return
	RET

STKRT0:	POP P,CX		; Recover count
	SUB P,CX		; Adjust stack to remove block
	RET			; Do non-skip return

; Support for SAVET macro.

.SAV1::	PUSH P,Q1
	PUSHJ P,0(CX)
	 SKIPA
	AOS -1(P)
	POP P,Q1
	POPJ P,

.SAVT::	PUSH P,T1
	PUSH P,T2
	PUSH P,T3
	PUSH P,T4
	CALL 0(CX)
RESTT::	 CAIA
	AOS -4(P)
	POP P,T4
	POP P,T3
	POP P,T2
	POP P,T1
	RET

.SAVQ::	PUSH P,Q1
	PUSH P,Q2
	PUSH P,Q3
	CALL 0(CX)
RESTQ::	 CAIA
	AOS -3(P)
	POP P,Q3
	POP P,Q2
	POP P,Q1
	RET

.SAVP::	PUSH P,P1
	PUSH P,P2
	PUSH P,P3
	PUSH P,P4
	PUSH P,P5
	PUSH P,P6
	CALL 0(CX)
RESTP::	 CAIA
	AOS -6(P)
	POP P,P6
	POP P,P5
	POP P,P4
	POP P,P3
	POP P,P2
	POP P,P1
	RET

	END